home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d11 / graph11.arc / GRAPHER.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-08-21  |  14.6 KB  |  598 lines
  1. (*$N+*)
  2. program BGIGrapher;
  3.  
  4. uses
  5.   Crt, Dos, Graph;
  6.  
  7. Const
  8.  MaxData = 600;
  9.  
  10. Type
  11.  Data = array [1..MaxData] of Extended;
  12.  GraphContents =  Record
  13.                     X,Y:Data;
  14.                     XMin,XMax,YMin,YMax:Extended;
  15.                     AbsXMax,AbsYMax:Extended;
  16.                  end;
  17.  
  18.  
  19.  
  20. var
  21.   FileName,Labels: string;
  22.   Graphs:GraphContents;   (* Some important info. on data *)
  23.   NoOfData,i,Starting,Ending:integer;
  24.   GraphDriver : integer;  (* The Graphics device driver *)
  25.   GraphMode   : integer;  (* The Graphics mode value *)
  26.   MaxX, MaxY  : word;     (* The maximum resolution of the screen *)
  27.   ErrorCode   : integer;  (* Reports any graphics errors *)
  28.   MaxColor    : word;     (* The maximum color value available *)
  29.   OldExitProc : Pointer;  (* Saves exit procedure address *)
  30.  
  31.  
  32. (* Display help screen *)
  33. procedure HelpScreen;
  34.  
  35. begin
  36.   Writeln ('FreeWare Experimental Grapher ');
  37.   Writeln ('(C)opyright TakaPuna 1991 Version 1.1');
  38.   Writeln ('Portions of the codes are (C)opyrighted by Borland International ');
  39.   Writeln;
  40.   Writeln ('Command Line Options:');
  41.   Writeln ('    FileName [All Labels] [Starting Ending Labels] ');
  42.   Writeln;
  43.   Writeln ('    FileName : Data file from a text file ');
  44.   Writeln ('    Starting : Starting index to view (integer)  ');
  45.   Writeln ('    Ending   : Ending index to view   (integer)  ');
  46.   Writeln ('    Labels   : Axis labels                       ');
  47.   Writeln;
  48.   Writeln ('Example:');
  49.   Writeln ('- To display all points and label the axis as');
  50.   Writeln ('  "X vs Y" >: Grapher FileName All X vs Y ');
  51.   Writeln ('- To display points #10 to #20 and label the axis as');
  52.   Writeln ('  "X vs Y" >: Grapher FileName 10 20 X vs Y ');
  53.   Writeln ('- All parameter must appear in order !!!!');
  54.   Halt (1);
  55. end;
  56.  
  57.  
  58. (*$F+*)
  59. (* Trap run time errors *)
  60. procedure UserExitProc;
  61. begin
  62.   ExitProc := OldExitProc; (* Restore exit procedure address *)
  63.   CloseGraph;
  64. end; (* UserExitProc *)
  65. (*$F-*)
  66.  
  67.  
  68. procedure Initialize;
  69. (* Initialize graphics and report any errors that may occur *)
  70. var
  71.   InGraphicsMode : boolean; (* Flags initialization of graphics mode *)
  72.   PathToDriver   : string;  (* Stores the DOS path to *.BGI & *.CHR *)
  73. begin
  74.   (* when using Crt and graphics, turn off Crt's memory-mapped writes *)
  75.   DirectVideo := False;
  76.   OldExitProc := ExitProc;                (* save previous exit proc *)
  77.   ExitProc := @UserExitProc;                (* insert our exit proc in chain *)
  78.   PathToDriver := '';
  79.   repeat
  80.  
  81. (*$IFDEF Use8514*)                          (* check for Use8514 $DEFINE *)
  82.     GraphDriver := IBM8514;
  83.     GraphMode := IBM8514Hi;
  84. (*$ELSE*)
  85.     GraphDriver := Detect;                (* use autodetection *)
  86. (*$ENDIF*)
  87.  
  88.     InitGraph(GraphDriver, GraphMode, PathToDriver);
  89.     ErrorCode := GraphResult;             (* preserve error return *)
  90.     if ErrorCode <> grOK then             (* error? *)
  91.     begin
  92.       Writeln('Graphics error: ', GraphErrorMsg(ErrorCode));
  93.       if ErrorCode = grFileNotFound then  (* Can't find driver file *)
  94.       begin
  95.         Writeln('Enter full path to BGI driver or type <Ctrl-Break> to quit:');
  96.         Readln(PathToDriver);
  97.       end
  98.       else
  99.         Halt(1);                          (* Some other error: terminate *)
  100.     end;
  101.   until ErrorCode = grOK;
  102.   MaxColor := GetMaxColor;  (* Get the maximum allowable drawing color *)
  103.   MaxX := GetMaxX;          (* Get screen resolution values *)
  104.   MaxY := GetMaxY;
  105. end; (* Initialize *)
  106.  
  107.  
  108. (* Returns true if file exists *)
  109. function FileExist (FileName:string):boolean;
  110.  
  111.  Var
  112.   F:Text;
  113.  
  114.  begin
  115.    (*$I-*)
  116.    Assign (F,FileName);
  117.    Reset (F);
  118.    FileExist:= IOResult = 0;
  119.   (*$I+*)
  120.  end;
  121.  
  122.  
  123.  
  124. function Int2Str(L : LongInt) : string;
  125. (* Converts integer to string *)
  126. var
  127.   S : string;
  128. begin
  129.   Str(L, S);
  130.   Int2Str := S;
  131. end; (* Int2Str *)
  132.  
  133.  
  134. function Str2Int(S:string):integer;
  135. (* Converts string to integer *)
  136. var
  137.  L,Code:integer;
  138.  
  139.  begin
  140.   Val(S,L,Code);
  141.   if Code <> 0 then
  142.    begin
  143.     Writeln ('Integer values expected as parameters.');
  144.     Halt(1);
  145.    end
  146.   else
  147.   Str2Int:=L;
  148.  end;
  149.  
  150.  
  151. function Real2Str(L : Extended) : string;
  152. (* Converts Extended numbers to string *)
  153. var
  154.   S : string;
  155. begin
  156.   Str(L:0, S);
  157.   Real2Str := S;
  158. end; (* Real2Str *)
  159.  
  160. (* Check if the Parameter is equal to the Switch *)
  161. function IsEqual(Parameter,Switch:String):boolean;
  162.  
  163.  var
  164.   Quit:boolean;
  165.  
  166.  begin
  167.   Quit:=false;
  168.   i:=0;
  169.   While not Quit do
  170.    begin
  171.     Inc(i);
  172.     Quit:=(Upcase(Switch[i])<>Upcase(Parameter[i])) or (i=Length(Switch));
  173.    end;
  174.    if i=Length(Switch) then
  175.     IsEqual:=true
  176.    else
  177.     IsEqual:=false;
  178.  end;
  179.  
  180. procedure DefaultColors;
  181. (* Select the maximum color in the Palette for the drawing color *)
  182. begin
  183.   SetColor(MaxColor);
  184. end; (* DefaultColors *)
  185.  
  186.  
  187. procedure FullPort;
  188. (* Set the view port to the entire screen *)
  189. begin
  190.   SetViewPort(0, 0, MaxX, MaxY, ClipOff);
  191. end; (* FullPort *)
  192.  
  193. procedure MainWindow(Header : string);
  194. (* Make a default window and view port for demos *)
  195. begin
  196.   DefaultColors;                           (* Reset the colors *)
  197.   SetTextStyle(SmallFont, HorizDir, 5);
  198.   SetTextJustify(CenterText, TopText);     (* Left justify text *)
  199.   FullPort;                                (* Full screen view port *)
  200.   OutTextXY(MaxX div 2,0, Header);        (* Draw the header *)
  201.   (* Draw main window *)
  202.   SetViewPort (Round(0.2*MaxX),Round(0.1*MaxY),Round(0.9*MaxX),Round(0.7*MaxY),
  203.                ClipOff);
  204.  
  205. end; (* MainWindow *)
  206.  
  207.  
  208. procedure WaitToGo;
  209. (* Wait for the user to abort the program or continue *)
  210. const
  211.   Esc = #27;
  212. var
  213.   Ch : char;
  214. begin
  215.   repeat until KeyPressed;
  216.   Ch := ReadKey;
  217.   if ch = #0 then ch := readkey;      (* trap function keys *)
  218.   if Ch = Esc then
  219.     Halt(0)                           (* terminate program *)
  220.   else
  221.     ClearDevice;                      (* clear screen *)
  222.  
  223. end; (* WaitToGo *)
  224.  
  225.  
  226.  
  227. (* Initialize the Graph Record *)
  228. procedure InitGlobal (UserGivenFile:string);
  229.  
  230. var
  231.  FileName:text;
  232.  j:integer;
  233.  a,b:Extended;
  234.  TXmax,TXmin,TYmax,TYmin:Extended;
  235.  Quit:boolean;
  236.  
  237.  begin
  238.    NoOfData:=0;
  239.    j:=1;
  240.    i:=1;
  241.    ClrScr;
  242.    Quit:=false;
  243.    Assign (FileName,UserGivenFile);
  244.    Reset (FileName);
  245.    While not Quit do
  246.     begin
  247.      (*$I-*)
  248.      Readln (FileName,a,b);
  249.      (*$I+*)
  250.      if IOResult = 0 then
  251.        begin
  252.          if ParamCount > 2 then
  253.           begin
  254.            if (j>=Starting) and (j<=Ending) then
  255.             begin
  256.              Graphs.X[i]:=a;
  257.              Graphs.Y[i]:=b;
  258.              Inc (NoOfData);
  259.              Inc (i);
  260.             end;
  261.           end
  262.          else
  263.            begin
  264.             Graphs.X[i]:=a;
  265.             Graphs.Y[i]:=b;
  266.             Inc (NoOfData);
  267.             Inc(i);
  268.            end;
  269.          Inc(j);
  270.        end
  271.      else
  272.       Writeln ('Some Invalid entries skipped ');
  273.     Quit:=(NoOfData = MaxData) or (j=Ending) or EOF(FileName);
  274.   end;  (* While not Quit *)
  275.  Close (FileName);
  276.  
  277.  if (NoOfData = MaxData) then
  278.    begin
  279.     Writeln ('Too many data .....Aborting program.  Maximum data = ',MaxData);
  280.     Halt(1);
  281.    end
  282.   else
  283.  
  284.    begin
  285.     TXmax:=Graphs.X[1];  (* find the maximum and the minimum of data *)
  286.     TXMin:=Graphs.X[1];
  287.     TYMax:=Graphs.Y[1];
  288.     TYMin:=Graphs.Y[1];
  289.  
  290.     for i:=1 to NoOfData do
  291.      begin
  292.       if Graphs.X[i] > TXMax then
  293.         TXMax:=Graphs.X[i];
  294.  
  295.       if Graphs.X[i] < TXMin then
  296.         TXMin:=Graphs.X[i];
  297.  
  298.       if Graphs.Y[i] > TYMax then
  299.         TYMax:=Graphs.Y[i];
  300.  
  301.       if Graphs.Y[i] < TYMin then
  302.         TYMin:=Graphs.Y[i];
  303.      end;
  304.  
  305.      Graphs.XMax:=TXMax;
  306.      Graphs.XMin:=TXMin;
  307.      Graphs.YMax:=TYMax;
  308.      Graphs.YMin:=TYMin;
  309.  
  310.      if Graphs.XMax= Graphs.XMin then
  311.       begin
  312.        Writeln ('Data does not make sense.');
  313.        Halt(1);
  314.       end;
  315.  
  316.      if (Abs(TXmin) > Abs(TXMax)) then
  317.       Graphs.AbsXMax:=Abs(TXMin)
  318.      else
  319.       Graphs.AbsXMax:=Abs(TXMax);
  320.  
  321.  
  322.      if (Abs(TYmin) > Abs(TYMax)) then
  323.       Graphs.AbsYMax:=Abs(TYMin)
  324.      else
  325.       Graphs.AbsYMax:=Abs(TYMax);
  326.  
  327.  
  328.   end;
  329.  
  330. end;  (*  InitGlobal *)
  331.  
  332.  
  333. procedure Status(Msg : string);
  334. (* report the status of graph *)
  335.  
  336. begin
  337.   FullPort;
  338.   DefaultColors;
  339.   SetTextJustify(CenterText, TopText);
  340.   SetLineStyle(SolidLn, 0, NormWidth);
  341.   SetFillStyle(EmptyFill, 0);
  342.   OutTextXY(MaxX div 2,MaxY-(TextHeight('M')+20),Msg);
  343.   (* Draw main window back again *)
  344.   SetViewPort (Round(0.2*MaxX),Round(0.1*MaxY),Round(0.9*MaxX),Round(0.7*MaxY),
  345.                ClipOff);
  346.  
  347. end; (* Status *)
  348.  
  349.  
  350. procedure DrawBorder;
  351. (* Draw a border around the current view port
  352.    and labels the axis                      *)
  353. var
  354.   ViewPort : ViewPortType;
  355.   IncX,IncY,Start:Extended;
  356.   Mult:Extended;
  357.  
  358. begin
  359.  
  360.   if (Graphs.XMax > 0) and (Graphs.XMin >= 0) then
  361.     IncX:=(Graphs.XMax-Graphs.XMin)/4;
  362.   if (Graphs.XMax < 0) and (Graphs.XMin < 0) then
  363.     IncX:=(-Abs(Graphs.XMax)+Abs(Graphs.XMin))/4;
  364.   if (Graphs.XMax >= 0) and (Graphs.XMin < 0) then
  365.      IncX:=(Abs(Graphs.XMax)+Abs(Graphs.XMin))/4;
  366.  
  367.   if (Graphs.YMax=Graphs.YMin) then
  368.        IncY:=Abs(Graphs.YMax/4)
  369.   else
  370.    begin
  371.     If (Graphs.YMax > 0) and (Graphs.YMin >= 0) then
  372.      IncY:=(Graphs.YMax-Graphs.YMin)/4;
  373.     If (Graphs.YMax < 0) and (Graphs.YMin < 0) then
  374.      IncY:=(-Abs(Graphs.YMax)+Abs(Graphs.YMin))/4;
  375.     if (Graphs.YMax >= 0) and (Graphs.YMin < 0) then
  376.      IncY:=(Abs(Graphs.YMax)+Abs(Graphs.YMin))/4;
  377.    end;
  378.  
  379.   Status ('Step size X = '+Real2Str(IncX)+
  380.           '   Step size Y ='+Real2Str(IncY));
  381.  
  382.   DefaultColors;
  383.   SetLineStyle(SolidLn,0, ThickWidth);
  384.   GetViewSettings(ViewPort);
  385.   SetTextStyle(SmallFont, HorizDir, 5);
  386.   with ViewPort do
  387.    begin
  388.     Rectangle(0, 0, x2-x1, y2-y1);
  389.  
  390.     (* Rectangle edges *)
  391.     Line (X2-X1+4,0,X2-X1-1,0);
  392.     Line (0,-4,0,1);
  393.     Line (0,Y2-Y1+4,0,Y2-Y1-1);
  394.     Line (-4,0,1,0);
  395.  
  396.  
  397.     (* Draw ticks on Y axis *)
  398.     Mult:=0.25;
  399.     for i:=1 to 4 do
  400.      begin
  401.        Line (X2-X1+4,Round(Mult*(Y2-Y1)),X2-X1-1,Round(Mult*(Y2-Y1)));
  402.        Line (-4,Round(Mult*(Y2-Y1)),1,Round(Mult*(Y2-Y1)));
  403.        Mult:=Mult+0.25;
  404.      end;
  405.  
  406.     (* Label the Y Axis *)
  407.     if (Graphs.YMax=Graphs.YMin) then
  408.       Start:=Graphs.YMax-(2*IncY)
  409.     else
  410.       Start:=Graphs.YMin;
  411.  
  412.     Mult:=1;
  413.     for i:=1 to 5 do
  414.      begin
  415.        OutTextXY (-4-TextWidth(Real2Str(Start)),Round(Mult*(Y2-Y1))-TextHeight(Real2Str(Start)),
  416.                   Real2Str(Start));
  417.        Mult:=Mult-0.25;
  418.        Start:=Start+IncY;
  419.      end;
  420.  
  421.  
  422.     (* Draw ticks on X axis *)
  423.     Mult:=0.25;
  424.     for i:=1 to 4 do
  425.      begin
  426.       Line (Round(Mult*(X2-X1)),-4,Round(Mult*(X2-X1)),1);
  427.       Line (Round(Mult*(X2-X1)),Y2-Y1+4,Round(Mult*(X2-X1)),Y2-Y1-1);
  428.       Mult:=Mult+0.25;
  429.      end;
  430.  
  431.  
  432.     (* Label the X axis *)
  433.     Mult:=0;
  434.     Start:=Graphs.Xmin;
  435.     for i:=1 to 5 do
  436.      begin
  437.       OutTextXY (Round(Mult*(X2-X1))-TextWidth(Real2Str(Start)) div 4,Y2-Y1+TextHeight(Real2Str(Start)),
  438.                  Real2Str(Start));
  439.       Mult:=Mult+0.25;
  440.       Start:=Start+IncX;
  441.      end;
  442.  
  443.   end;  (* with ViewPort *)
  444.  
  445. end; (* DrawBorder *)
  446.  
  447.  
  448.  
  449. procedure ScaleData;
  450. (* Scale the data such that it will fall inside the viewport *)
  451.  
  452.  var
  453.   ShiftX,ShiftY:integer;
  454.   Xscale,YScale:Extended;
  455.   ViewPort:ViewPortType;
  456.  
  457.  begin
  458.   GetViewSettings(ViewPort);
  459.   With ViewPort do
  460.    begin
  461.     (* Put some conditions on X *)
  462.  
  463.     if (Graphs.XMax > 0 ) and (Graphs.XMin > 0) then (* XMax > 0 *)
  464.      begin                                           (* XMin > 0 *)
  465.       XScale:=(X2-X1)/(Graphs.XMax-Graphs.XMin);
  466.       ShiftX:=-Round(Graphs.XMax*XScale-X2+X1);
  467.      end
  468.     else
  469.      begin
  470.         if Graphs.XMax > 0 then       (* absolutely no zero *)
  471.          begin
  472.           ShiftX:=Round((1-(Graphs.XMax/(Graphs.XMax + Abs(Graphs.Xmin))))*(X2-X1));
  473.           XScale:=(X2-(ShiftX+X1))/(Graphs.XMax);
  474.           if XScale = 0 then
  475.            XScale:=(X2-X1)/(Graphs.AbsXMax)
  476.          end
  477.         else
  478.          begin
  479.           XScale:=(X2-X1)/(Graphs.XMax-Graphs.XMin);
  480.           ShiftX:=-Round(Graphs.XMax*XScale-X2+X1);
  481.          end;
  482.     end;
  483.  
  484.    (* Put Some condition on Y *)
  485.    if (Graphs.YMax=Graphs.YMin) then
  486.     begin
  487.      for i:=1 to NoOfData do
  488.       begin
  489.        Graphs.X[i]:=Graphs.X[i]*XScale+ShiftX;
  490.        Graphs.Y[i]:=0.5*(Y2-Y1);
  491.       end;
  492.     end
  493.    else
  494.     begin
  495.      if (Graphs.YMax > 0 ) and (Graphs.YMin > 0) then (* YMax > 0 *)
  496.        begin                                           (* YMin > 0 *)
  497.         YScale:=(Y2-Y1)/(Graphs.YMax-Graphs.YMin);
  498.         ShiftY:=-Round(Graphs.YMax*YScale-y2+y1);
  499.        end
  500.      else
  501.       begin
  502.        if (Graphs.YMax > 0) then
  503.         begin
  504.          ShiftY:=Round((1-(Graphs.YMax/(Graphs.YMax + Abs(Graphs.Ymin))))*(Y2-Y1));
  505.          YScale:=(Y2-(ShiftY+Y1))/Graphs.YMax;
  506.          if YScale= 0 then
  507.           YScale:=(Y2-Y1)/(Graphs.AbsYMax);
  508.         end
  509.        else
  510.         begin
  511.          YScale:=(Y2-Y1)/(Graphs.YMax-Graphs.YMin);
  512.          ShiftY:=-Round(Graphs.YMax*YScale-y2+y1);
  513.         end;
  514.     end;
  515.      for i:=1 to NoOfData do
  516.       begin
  517.        Graphs.X[i]:=Graphs.X[i]*XScale+ShiftX;
  518.        Graphs.Y[i]:=Graphs.Y[i]*YScale+ShiftY;
  519.       end;
  520.      end;
  521.    end;
  522.  
  523. end;  (* Scale Data *)
  524.  
  525.  
  526. procedure Plot;
  527. (* plot the given data in the array *)
  528.  
  529. var
  530.  ViewPort:ViewPortType;
  531.  
  532. begin
  533.  SetLineStyle(SolidLn, 0, NormWidth);
  534.  GetViewSettings(ViewPort);
  535.  With ViewPort do
  536.   begin
  537.    MoveTo (Round(Graphs.X[1]),
  538.           (Y2-Y1)-Round(Graphs.Y[1]));
  539.    for i:=2 to NoOfData do
  540.     LineTo (Round(Graphs.X[i]),
  541.             (Y2-Y1)-Round(Graphs.Y[i]));
  542.   end;
  543. end; (* Plot *)
  544.  
  545.  
  546. (* Handles command line input *)
  547. procedure CommandLine;
  548.  
  549.  begin
  550.   if ParamCount = 0 then
  551.    HelpScreen
  552.   else
  553.    begin
  554.     Labels:='';
  555.     FileName:=ParamStr(1);
  556.     if NOT FileExist(FileName) then
  557.        begin
  558.         Writeln ('File ',FileName,' does not exist.');
  559.         Halt(1);
  560.        end;
  561.     if ParamCount > 2 then
  562.      begin
  563.       if Not (IsEqual(ParamStr(2),'All')) then
  564.        begin
  565.         Starting:=Str2Int(ParamStr(2));
  566.         Ending:=Str2Int(ParamStr(3));
  567.         if (Starting > Ending) then
  568.          begin
  569.           Writeln ('Starting index must be less than ending index. ');
  570.           Halt(1);
  571.          end;
  572.         for i:=4 to ParamCount do
  573.          Labels:=Labels +' '+ ParamStr(i);
  574.       end
  575.      else
  576.       begin
  577.         Starting:=1;
  578.         Ending:=MaxData;
  579.         for i:=3 to ParamCount do
  580.          Labels:=Labels +' '+ ParamStr(i);
  581.       end;
  582.     end;
  583.    end;
  584.  end;
  585.  
  586.  
  587. begin (* program body *)
  588.   ClrScr;
  589.   CommandLine;
  590.   InitGlobal (FileName);
  591.   Initialize;
  592.   MainWindow (Labels);
  593.   ScaleData;
  594.   DrawBorder;
  595.   Plot;
  596.   WaitToGo;
  597. end.
  598.